home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / network / info-sys / www / tkhtml-2.3 / tkhtml-2 / tkHTML-2.3 / preview.tcl < prev    next >
Encoding:
Text File  |  1995-02-06  |  18.3 KB  |  740 lines
  1. ##################
  2. # Preview-mode stuff
  3. # most of this was taken from tkWWW, salted-to-taste
  4.  
  5.  
  6. proc Preview {pagename} {
  7.     global filename
  8.     global current
  9.     set current $pagename
  10.  
  11.     ClearEvent "Creating preview window"
  12.  
  13.     toplevel .preview
  14.  
  15.     frame .preview.t -relief raised -borderwidth 2
  16.     label .preview.t.label -text "Document Title: "  
  17.     pack .preview.t.label -side left -expand false -padx 20
  18.     label .preview.t.t 
  19.     pack .preview.t.t -side left -expand true -fill x
  20.  
  21.     frame .preview.vp 
  22.     
  23.     text .preview.vp.txt -yscrollcommand {.preview.vp.sc set} \
  24.         -relief sunken -borderwidth 2  \
  25.         -wrap word -background #bfbfbfbfbfbf -height 24 -width 80
  26.  
  27.  
  28.     scrollbar .preview.vp.sc -orient vertical -borderwidth 2 \
  29.         -relief sunken -command {.preview.vp.txt yview} 
  30.  
  31.     pack .preview.t -side top -fill x -expand false
  32.     pack .preview.vp -fill both -expand true
  33.     pack .preview.vp.txt -side right -fill both -expand true
  34.     pack .preview.vp.sc -side left -fill both
  35.  
  36.     button .preview.reload -text "Reload" \
  37.         -command {
  38.             SaveForPreview
  39.         }
  40.     button .preview.ok -text "Close" \
  41.         -command {
  42.             if {[info commands XFDestroy] != ""} {
  43.                 catch {HtUncache "$pagename"}
  44.                 catch {XFDestroy .preview}
  45.             } else {
  46.                 catch {HtUncache "$pagename"}
  47.             catch {destroy .preview}
  48.             }
  49.         }
  50.  
  51.     tixCombobox .preview.font  -type static -width 1 \
  52.         -fancy yes -command {ChangePreviewFont}
  53.     .preview.font appendhistory "Times"
  54.     .preview.font appendhistory "Helvetica"
  55.     .preview.font appendhistory "New Century Schoolbook"
  56.     .preview.font appendhistory "Lucida"
  57.     SetFontStartup
  58.  
  59.     pack .preview.ok .preview.reload .preview.font -fill both \
  60.         -expand true -side left -padx 5 -pady 2
  61.  
  62. DoPreview $pagename
  63. #tkW3FontInitialize
  64. }
  65.  
  66. #######################################
  67. # set the fotn when you start previwer
  68.  
  69. proc SetFontStartup {} {
  70.     global typeface
  71.     if {$typeface == "times"} {
  72.         .preview.font pick "Times"
  73.     } elseif {$typeface == "helvetica"} {
  74.         .preview.font pick "Helvetica"
  75.     } elseif {$typeface == "century"} {
  76.         .preview.font pick "New Century Schoolbook"
  77.     } elseif {$typeface == "lucida"} {
  78.         .preview.font pick "Lucida"
  79.     }
  80. }
  81.  
  82. ######################
  83. # change the previewer font
  84. #
  85.  
  86. proc ChangePreviewFont {string} {
  87.     global current
  88.     global typeface
  89.     if {$string == "Times"} {
  90.         set typeface "times"
  91.         DoPreview $current        
  92.     } elseif {$string == "Helvetica"} {
  93.         set typeface "helvetica"
  94.         DoPreview $current
  95.     } elseif {$string == "New Century Schoolbook"} {
  96.         set typeface "century"
  97.         DoPreview $current
  98.     } elseif {$string == "Lucida"} {
  99.         set typeface "lucida"
  100.         DoPreview $current
  101.     }
  102.  
  103. }
  104.  
  105. ############################################
  106. # this is nasty, but it works
  107. # I should procedurize the font-building
  108.  
  109. proc DoPreview {pagename} {
  110.     global typeface
  111.     global filename
  112.  
  113.     ClearEvent "Previewing..."
  114.  
  115.     tkW3OutputCursorWait
  116.     catch {HtUncache "$pagename"}
  117.     #tkW3HtBeginDoc
  118.     .preview.vp.txt delete 1.0 end
  119.  
  120.     if {$typeface == "times"} {
  121.         tkW3FontSetTextFonts .preview.vp.txt {
  122.             {"" "-adobe-times-medium-r-*-*-12-*-*-*-*-*-*-*"}
  123.             {"H1" "-adobe-times-bold-r-normal-*-24-*-*-*-*-*-*-*"}
  124.             {"H2" "-adobe-times-bold-r-normal-*-18-*-*-*-*-*-*-*"}
  125.             {"H3" "-adobe-times-bold-r-normal-*-18-*-*-*-*-*-*-*"}
  126.             {"H4" "-adobe-times-bold-r-normal-*-14-*-*-*-*-*-*-*"}
  127.             {"H5" "-adobe-times-bold-r-normal-*-12-*-*-*-*-*-*-*"}
  128.             {"H6" "-adobe-times-bold-r-normal-*-10-*-*-*-*-*-*-*"}
  129.             {"ADDRESS" "-adobe-times-medium-i-normal-*-14-*-*-*-*-*-*-*"}
  130.             {"XMP" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  131.             {"PRE" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  132.             {"TT" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  133.             {"CODE" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  134.             {"SAMP" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  135.             {"EM" "-adobe-times-bold-r-*-*-12-*-*-*-*-*-*-*"}
  136.             {"STRONG" "-adobe-times-bold-r-normal-*-14-*-*-*-*-*-*-*"}
  137.             {"B" "-adobe-times-bold-r-normal-*-14-*-*-*-*-*-*-*"}
  138.             {"I" "-adobe-times-medium-i-normal-*-14-*-*-*-*-*-*-*"}  
  139.         }
  140.     } elseif {$typeface == "century" } {
  141.         tkW3FontSetTextFonts .preview.vp.txt {
  142.             {"" "-adobe-new century schoolbook-medium-r-*-*-12-*-*-*-*-*-*-*"}
  143.             {"H1" "-adobe-new century schoolbook-bold-r-normal-*-24-*-*-*-*-*-*-*"}
  144.             {"H2" "-adobe-new century schoolbook-bold-r-normal-*-18-*-*-*-*-*-*-*"}
  145.             {"H3" "-adobe-new century schoolbook-bold-r-normal-*-18-*-*-*-*-*-*-*"}
  146.             {"H4" "-adobe-new century schoolbook-bold-r-normal-*-14-*-*-*-*-*-*-*"}
  147.             {"H5" "-adobe-new century schoolbook-bold-r-normal-*-12-*-*-*-*-*-*-*"}
  148.             {"H6" "-adobe-new century schoolbook-bold-r-normal-*-10-*-*-*-*-*-*-*"}
  149.             {"ADDRESS" "-adobe-new century schoolbook-medium-r-normal-*-14-*-*-*-*-*-*-*"}
  150.             {"XMP" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  151.             {"PRE" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  152.             {"TT" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  153.             {"CODE" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  154.             {"SAMP" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  155.             {"B" "-adobe-new century schoolbook-bold-r-normal-*-12-*-*-*-*-*-*-*"}
  156.             {"EM" "-adobe-new century schoolbook-bold-r-normal-*-12-*-*-*-*-*-*-*"}
  157.             {"STRONG" "-adobe-new century schoolbook-bold-r-normal-*-14-*-*-*-*-*-*-*"}
  158.             {"I" "-adobe-new century schoolbook-medium-i-normal-*-14-*-*-*-*-*-*-*"}
  159.         }
  160.     } elseif {$typeface == "lucida" } {
  161.         tkW3FontSetTextFonts .preview.vp.txt {
  162.             {"" "-b&h-lucida-medium-r-*-*-12-*-*-*-*-*-*-*"}
  163.             {"H1" "-b&h-lucida-bold-r-normal-*-24-*-*-*-*-*-*-*"}
  164.             {"H2" "-b&h-lucida-bold-r-normal-*-18-*-*-*-*-*-*-*"}
  165.             {"H3" "-b&h-lucida-bold-r-normal-*-18-*-*-*-*-*-*-*"}
  166.             {"H4" "-b&h-lucida-bold-r-normal-*-14-*-*-*-*-*-*-*"}
  167.             {"H5" "-b&h-lucida-bold-r-normal-*-12-*-*-*-*-*-*-*"}
  168.             {"H6" "-b&h-lucida-bold-r-normal-*-12-*-*-*-*-*-*-*"}
  169.             {"ADDRESS" "-b&h-lucida-medium-i-normal-*-14-*-*-*-*-*-*-*"}
  170.             {"XMP" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  171.             {"PRE" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  172.             {"TT" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  173.             {"CODE" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  174.             {"SAMP" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  175.             {"B" "-b&h-lucida-bold-r-normal-*-12-*-*-*-*-*-*-*"}
  176.             {"EM" "-b&h-lucida-bold-r-normal-*-12-*-*-*-*-*-*-*"}
  177.             {"STRONG" "-b&h-lucida-bold-r-normal-*-14-*-*-*-*-*-*-*"}
  178.             {"I" "-b&h-lucida-medium-i-normal-*-14-*-*-*-*-*-*-*"}
  179.         }
  180.     } elseif {$typeface == "helvetica"} {
  181.         tkW3FontSetTextFonts .preview.vp.txt {
  182.             {"" "-adobe-helvetica-medium-r-*-*-14-*-*-*-*-*-*-*"}
  183.             {"H1" "-adobe-helvetica-bold-r-normal-*-24-*-*-*-*-*-*-*"}
  184.             {"H2" "-adobe-helvetica-bold-r-normal-*-18-*-*-*-*-*-*-*"}
  185.             {"H3" "-adobe-helvetica-bold-r-normal-*-18-*-*-*-*-*-*-*"}
  186.             {"H4" "-adobe-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*"}
  187.             {"H5" "-adobe-helvetica-bold-r-normal-*-12-*-*-*-*-*-*-*"}
  188.             {"H6" "-adobe-helvetica-bold-r-normal-*-10-*-*-*-*-*-*-*"}
  189.             {"ADDRESS" "-adobe-helvetica-medium-r-normal-*-14-*-*-*-*-*-*-*"}
  190.             {"XMP" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  191.             {"PRE" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  192.             {"TT" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  193.             {"CODE" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  194.             {"SAMP" "-adobe-courier-medium-r-normal-*-12-*-*-*-*-*-*-*"}
  195.             {"B" "-adobe-helvetica-bold-r-normal-*-12-*-*-*-*-*-*-*"}
  196.             {"EM" "-adobe-helvetica-bold-r-normal-*-12-*-*-*-*-*-*"}
  197.             {"STRONG" "-adobe-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*"}
  198.             {"I" "-adobe-helvetica-medium-o-normal-*-14-*-*-*-*-*-*-*"}
  199.         }
  200.     }
  201.     catch {HtLoad $pagename}
  202.     tkW3OutputCursorNormal
  203. }    
  204.  
  205.  
  206. # Procedure: insertWithTags
  207. proc insertWithTags { w text args} {
  208.     set start [$w index insert]
  209.     $w insert insert $text
  210.     foreach tag [$w tag names $start] {
  211.         $w tag remove $tag $start insert
  212.     }
  213.     foreach i $args {
  214.         $w tag add $i $start insert
  215.     }
  216. }
  217.  
  218.  
  219. # Procedure: tkW3FontInitialize
  220. proc tkW3FontInitialize {} {
  221.     global tkW3ConfigFont tkW3ConfigFontList tkW3ConfigFontDefault
  222. #    puts "tkW3FontInitialize"
  223.  
  224. #    foreach item $tkW3ConfigFontList {
  225. #        pack append .font_dialog.f  [radiobutton .font_dialog.f.[lindex $item 0]  \
  226.             -text [lindex $item 1] -relief flat  \
  227.             -variable font_name -anchor w ] {top fillx}
  228. #    }
  229.  
  230.     tkW3FontSetTextFonts .preview.vp.txt $tkW3ConfigFont(times)
  231. #    $tkW3ConfigFont($tkW3ConfigFontDefault)
  232. }
  233.  
  234.  
  235. # Procedure: tkW3FontSetTextFonts
  236. proc tkW3FontSetTextFonts { w list} {
  237. #    puts "tkW3FontSetTextFonts"
  238.     foreach font $list {
  239.         set style [lindex $font 0]
  240.         if {$style == ""} {
  241.             $w configure -font [lindex $font 1]
  242.         } else {
  243.             $w tag configure $style -font [lindex $font 1]
  244.         }
  245.     }
  246.     $w tag configure U -underline true
  247. }
  248.  
  249.  
  250. # Procedure: tkW3HtAdd
  251. proc tkW3HtAdd { string {styles ""}} {
  252.     global tkW3HtText tkW3HtPage
  253. #    puts "tkW3HtAdd: styles->$styles"
  254.  
  255.     if $tkW3HtText(in_anchor) {
  256.         lappend styles Anchor
  257.         lappend styles h$tkW3HtPage(anchor.index)
  258.     }
  259.  
  260.     lappend styles [tkW3HtListLast tkW3HtText(para.stack)]
  261.   
  262.     if [llength $tkW3HtText(char.stack)] {
  263.         lappend styles [tkW3HtListLast tkW3HtText(char.stack)]
  264.     }
  265.     tkW3HtInsert $string $styles
  266. }
  267.  
  268.  
  269. # Procedure: tkW3HtAddBul
  270. proc tkW3HtAddBul { type} {
  271.     global tkW3HtText
  272. #    puts "tkW3HtAddBul: type->$type"
  273.  
  274.     switch -exact $type {
  275.         BR {
  276.             tkW3HtInsert "\n" BR
  277.             return
  278.         }
  279.  
  280.         HR {
  281.             tkW3HtInsert "\n_______________________________________________________________________________\n" HR
  282.         return
  283.         }
  284.  
  285.         P {
  286.             tkW3HtInsert "\n\n" P
  287.         return
  288.         }
  289.     
  290.         DT {
  291.             tkW3HtBlankLines 1
  292.         }
  293.         }
  294.  
  295.     tkW3HtInsert "\n" blank
  296.     for {set i 1} {$i < [llength $tkW3HtText(list.stack)]} {incr i} {
  297.         if {$type == "DD"} {
  298.             tkW3HtInsert "\t" "DD"
  299.         } {
  300.             tkW3HtInsert "\t" "LI"
  301.         }
  302.     }
  303.  
  304.     case $type {
  305.         "LI" {
  306.             tkW3HtInsert "   * " "LI type.[tkW3HtListLast tkW3HtText(list.stack)]"
  307.         }
  308.         "DD" {
  309.             tkW3HtInsert "     * " "DD"
  310.         }
  311.         "DT" {
  312.             tkW3HtInsert "     " "LI type.DL"
  313.         }
  314.     }
  315. }
  316.  
  317.  
  318. # Procedure: tkW3HtBegin
  319. proc tkW3HtBegin { stack elem} {
  320.     global tkW3HtText
  321. #    puts "tkW3HtBegin: stack->$stack elem->$elem"
  322.  
  323.     switch -regexp $elem {
  324.         {^H[1-9]+$} -
  325.         {^ADDRESS$} {
  326.             tkW3HtBlankLines 2
  327.         }
  328.         {^XMP$} -
  329.         {^PRE$} {
  330.             tkW3HtBlankLines 1
  331.         }
  332.         {^Q$} {
  333.             tkW3HtInsert "``" blank
  334.         }
  335.     }
  336.     lappend tkW3HtText($stack.stack) $elem
  337. }
  338.  
  339.  
  340. # Procedure: tkW3HtBeginAnc
  341. proc tkW3HtBeginAnc { name href} {
  342.     global tkW3HtPage tkW3HtText
  343. #    puts "tkW3HtBeginAnc: name->$name href->$href"
  344.  
  345.     set i $tkW3HtPage(anchor.index)
  346.     set tkW3HtPage(anchor.name.$i) $name
  347.     set tkW3HtPage(anchor.href.$i) $href
  348.     set tkW3HtPage(id.$name) h$i
  349.     set tkW3HtText(in_anchor) 1
  350.  
  351. #    if {$i >= $tkW3HtText(anchor.max)} {
  352.         .preview.vp.txt tag configure h$i -foreground blue  \
  353.             -background $tkW3HtText(background)
  354.         incr tkW3HtText(anchor.max)
  355. #    }
  356. }
  357.  
  358.  
  359. # Procedure: tkW3HtBeginDoc
  360. proc tkW3HtBeginDoc {} {
  361.     global tkW3HtPage tkW3HtText
  362. #    puts "tkW3HtBeginDoc"
  363.  
  364.     unset tkW3HtPage
  365.     set tkW3HtPage(anchor.index) 1
  366.     set tkW3HtPage(image.index) 1
  367.     set tkW3HtPage(is_index) 0
  368.     set tkW3HtPage(modified) 0
  369.     set tkW3HtPage(base) ""
  370.     set tkW3HtPage(base.use) 0
  371.     set tkW3HtPage(next_id) ""
  372.     set tkW3HtPage(index.href) ""
  373.     set tkW3HtPage(link) ""
  374.  
  375.     set tkW3HtText(in_anchor) 0
  376.     set tkW3HtText(list.stack) {}
  377.     set tkW3HtText(para.stack) {}
  378.     set tkW3HtText(char.stack) {}
  379.     set tkW3HtText(background) [lindex [.preview.vp.txt configure \
  380.         -background] 4]
  381. #    set i $tkW3HtPage(anchor.index)
  382. #    set tkW3HtPage(anchor.name.$i) ""
  383. #    set tkW3HtPage(anchor.href.$i) ""
  384.     tkW3OutputClearBody
  385. }
  386.  
  387.  
  388. # Procedure: tkW3HtBlankLines
  389. proc tkW3HtBlankLines { n} {
  390. #    puts "tkW3HtBlankLines: n->$n"
  391.     set text [regexp {^[ ]*$}  [.preview.vp.txt get {insert linestart} \
  392.         {insert - 1 char lineend}]]
  393.     if {!$text} {
  394.         for {set i 0} {$i<$n} {incr i} {
  395.             tkW3HtInsert "\n" blank
  396.         }
  397.     }
  398. }
  399.  
  400.  
  401. # Procedure: tkW3HtButtonPress
  402. proc tkW3HtButtonPress { w loc b} {
  403.     global tkW3HtPage tkW3HtText
  404. #    puts "tkW3HtButtonPress: w->$w loc->$loc b->$b"
  405.     set tag_list [.preview.vp.txt tag names $loc]
  406.     set index [lsearch -regexp $tag_list  {^i[0-9]+$}]
  407.  
  408.     if {$index == -1} {
  409.         set index [lsearch -regexp $tag_list  {^h[0-9]+$}]
  410.     }
  411.     if {$index != -1} {
  412.         $w tag configure [lindex $tag_list $index] -relief sunken
  413.         update idletasks
  414.     }
  415. }
  416.  
  417.  
  418. # Procedure: tkW3HtButtonRelease
  419. proc tkW3HtButtonRelease { w loc b} {
  420.     global tkW3HtPage tkW3HtText
  421. #    puts "tkW3HtButtonRelease"
  422.     set tag_list [.preview.vp.txt tag names $loc]
  423.  
  424.     # Search for active tag
  425.     # image tags override hypertext anchor tags 
  426.     set index [lsearch -regexp $tag_list  {^i[0-9]+$}]
  427.     if {$index == -1} {
  428.         set index [lsearch -regexp $tag_list  {^h[0-9]+$}]
  429.     }
  430.  
  431.     if {$index != -1} {
  432.         set tag [lindex $tag_list $index]
  433.         $w tag configure $tag -relief raised
  434.         update idletasks
  435.         regexp {([hi])([0-9]+)} $tag {} tag_type i
  436.         switch $tag_type {
  437.             "h" {
  438.                 switch $b {
  439.                     "1" {
  440.                         tkW3NavigateRecordAndGoto $tkW3HtPage(anchor.href.$i)
  441.                     }
  442.                     "2" {
  443.                         tkW3NavigateClone $tkW3HtPage(anchor.href.$i)
  444.                     }
  445.                     "3" {
  446.                         tkW3EditSetupAnchorDialog $w $i
  447.                     }
  448.                 }
  449.             }
  450.             "i" {
  451.                 switch $b {
  452.                     "1" {
  453.                         tkW3NavigateRecordAndGoto  $tkW3HtPage(image.$i) {}  $tkW3HtPage(image.anchor.$i)  $tkW3HtPage(image.ismap.$i)
  454.                     }
  455.                     "2" {
  456.                         tkW3NavigateClone $tkW3HtPage(image.$i) 
  457.                     }
  458.                     "3" {
  459.                         tkW3EditChangeImage $i
  460.                     }
  461.                 }
  462.             }
  463.         }
  464.     }
  465. }
  466.  
  467.  
  468. # Procedure: tkW3HtEnd
  469. proc tkW3HtEnd { stack elem} {
  470.     global tkW3HtText
  471. #    puts "tkW3HtEnd: stack->$stack elem->$elem"
  472.  
  473.     tkW3HtListPop tkW3HtText($stack.stack)
  474.  
  475.     switch -regexp $elem {
  476.         {^H[1-9]+$} -
  477.         {^ADDRESS$} {
  478.             tkW3HtBlankLines 1
  479.         }
  480.         {^Q$} {
  481.             tkW3HtInsert "''" blank
  482.         }
  483.     }
  484.  
  485.     if {$stack == "list" && $tkW3HtText(list.stack) == {}} {
  486.         tkW3HtBlankLines 2
  487.     }
  488. }
  489.  
  490.  
  491. # Procedure: tkW3HtEndAnc
  492. proc tkW3HtEndAnc {} {
  493.     global tkW3HtPage tkW3HtText
  494. #    puts "tkW3HtEndAnc"
  495.     set tkW3HtText(in_anchor) 0
  496.     incr tkW3HtPage(anchor.index)
  497. }
  498.  
  499.  
  500. # Procedure: tkW3HtEndDoc
  501. proc tkW3HtEndDoc {} {
  502.     global tkW3HtPage
  503. #    puts "tkW3HtEndDoc"
  504.     if {$tkW3HtPage(base) == ""} {
  505.         set tkW3HtPage(base) $tkW3HtPage(address)
  506.     }
  507. }
  508.  
  509.  
  510. # Procedure: tkW3HtInsert
  511. proc tkW3HtInsert { text {list ""}} {
  512.     set start [.preview.vp.txt index insert]
  513. #    puts "tkW3HtInsert: text->$text list->$list"
  514.     .preview.vp.txt insert insert $text
  515.     foreach tag [.preview.vp.txt tag names $start] {
  516.         .preview.vp.txt tag remove $tag $start insert
  517.     }
  518.     foreach tag $list {
  519.         .preview.vp.txt tag add $tag $start insert
  520.     }
  521. }
  522.  
  523.  
  524. # Procedure: tkW3HtListLast
  525. proc tkW3HtListLast { in_list} {
  526. #    puts "tkW3HtListLast: in_list->$in_list"
  527.     upvar $in_list list
  528.     set index [llength $list]
  529.     incr index -1
  530.     lindex $list $index
  531. }
  532.  
  533.  
  534. # Procedure: tkW3HtListPop
  535. proc tkW3HtListPop { in_list} {
  536. #    puts "tkW3HtListPop: in_list->$in_list"
  537.     upvar $in_list list
  538.     set index [llength $list]
  539.     incr index -1
  540.     set item [lindex $list $index]
  541.     incr index -1
  542.     set list [lrange $list 0 $index]
  543.     return $item
  544. }
  545.  
  546.  
  547. # Procedure: tkW3HtProgress
  548. proc tkW3HtProgress { msg} {
  549. #    puts "tkW3HtProgress: msg->$msg"
  550.     tkW3OutputSetMessage $msg
  551.     update idletasks
  552. }
  553.  
  554.  
  555. # Procedure: tkW3HtSetBase
  556. proc tkW3HtSetBase { href} {
  557.     global tkW3HtPage
  558. #    puts "tkW3HtSetBase: href->$href"
  559.     set tkW3HtPage(base.use) 1
  560.     set tkW3HtPage(base) $href
  561. }
  562.  
  563.  
  564. # Procedure: tkW3HtSetImg
  565. proc tkW3HtSetImg { source {ismap "0"}} {
  566.     global tkW3HtPage tkW3HtText
  567. #    puts "tkW3HtSetImg: source->$source ismap->$ismap"
  568.  
  569.     set image_string "<IMAGE"
  570.     set i $tkW3HtPage(image.index)
  571.  
  572.     set tkW3HtPage(image.ismap.$i) $ismap   
  573.     if $tkW3HtText(in_anchor) {
  574.         set anchor_num $tkW3HtPage(anchor.index)
  575.         set tkW3HtPage(image.anchor.$i) $tkW3HtPage(anchor.href.$anchor_num)
  576.         append image_string "-ANCHOR"
  577.         if {$ismap} {
  578.             append image_string "-ISMAP"
  579.         }
  580.     } {
  581.         set tkW3HtPage(image.anchor.$i) ""
  582.     }
  583.   
  584.     append image_string ">"
  585.  
  586.     tkW3HtAdd $image_string "Image i$i"
  587. #    if {$i > $tkW3HtText(image.max)} {
  588.         .preview.vp.txt tag configure i$i -foreground blue \
  589.             -background $tkW3HtText(background)
  590.         incr tkW3HtText(image.max)
  591. #    }
  592.     set tkW3HtPage(image.$i) $source
  593.     incr tkW3HtPage(image.index)
  594. }
  595.  
  596.  
  597. # Procedure: tkW3HtSetInd
  598. proc tkW3HtSetInd { href} {
  599.     global tkW3HtPage
  600. #    puts "tkW3HtSetInd: href->$href"
  601.     set tkW3HtPage(is_index) 1
  602.     set tkW3HtPage(index.href) $href
  603. }
  604.  
  605.  
  606. # Procedure: tkW3HtSetLink
  607. proc tkW3HtSetLink { relation href} {
  608.     global tkW3HtPage
  609. #    puts "tkW3HtSetLink relation->$relation href->$href"
  610.     lappend tkW3HtPage(link) $relation
  611.     set tkW3HtPage(link.$relation) $href
  612. }
  613.  
  614.  
  615. # Procedure: tkW3HtSetName
  616. proc tkW3HtSetName { address title} {
  617.     global tkW3HtPage
  618. #    puts "tkW3HtSetName: address->$address title->$title">
  619.     set tkW3HtPage(address) $address
  620.     set tkW3HtPage(title) $title
  621.     tkW3OutputSetAddress $address $title
  622. }
  623.  
  624.  
  625. # Procedure: tkW3HtSetNextId
  626. proc tkW3HtSetNextId { id} {
  627.     global tkW3HtPage
  628. #    puts "tkW3HtSetNextId: id->$id"
  629.     set tkW3HtPage(next_id) $id
  630. }
  631.  
  632.  
  633. # Procedure: tkW3OutputButtonSetSensitive
  634. proc tkW3OutputButtonSetSensitive { w var} {
  635. #    puts "tkW3OutputButtonSetSensitive: w->$w var->$var"
  636.     if {$var == 0} {
  637.         $w configure -state disabled
  638.     } {
  639.         $w configure -state normal
  640.     }
  641. }
  642.  
  643.  
  644. # Procedure: tkW3OutputClearBody
  645. proc tkW3OutputClearBody {} {
  646. #    puts "tkW3OutputClearBody"
  647.     .preview.vp.txt delete 1.0 end
  648. }
  649.  
  650.  
  651. # Procedure: tkW3OutputCursorNormal
  652. proc tkW3OutputCursorNormal {} {
  653.     .preview.vp.txt configure -cursor xterm
  654. }
  655.  
  656.  
  657. # Procedure: tkW3OutputCursorWait
  658. proc tkW3OutputCursorWait {} {
  659.     .preview.vp.txt configure -cursor watch
  660. }
  661.  
  662.  
  663. # Procedure: tkW3OutputDoNothing
  664. proc tkW3OutputDoNothing {} {
  665.  
  666. }
  667.  
  668.  
  669. # Procedure: tkW3OutputEntryPrint
  670. proc tkW3OutputEntryPrint { w message} {
  671. #    puts "tkW3OutputEntryPrint: w->$w message->$message"
  672.     $w configure -state normal
  673.     $w delete 0 end
  674.     $w insert 0 $message
  675.     $w configure -state disabled
  676. }
  677.  
  678.  
  679. # Procedure: tkW3OutputError
  680. proc tkW3OutputError { message} {
  681.     #DLG:msg . .error_dialog $message error "OK"
  682.     #puts stdout "Some error: $message"
  683. }
  684.  
  685.  
  686. # Procedure: tkW3OutputGetScrollPosition
  687. proc tkW3OutputGetScrollPosition {} {
  688. #    puts "tkW3OutputGetScrollPosition"
  689.     lindex [.preview.vp.sc get] 2
  690. }
  691.  
  692.  
  693. # Procedure: tkW3OutputMenuSetSensitive
  694. proc tkW3OutputMenuSetSensitive { w entry var} {
  695.     if {$var == 0} {
  696.         $w entryconfigure $entry -state disabled
  697.     } {
  698.         $w entryconfigure $entry -state normal
  699.     }
  700. }
  701.  
  702.  
  703. # Procedure: tkW3OutputSetAddress
  704. proc tkW3OutputSetAddress { address title} {
  705. #    tkW3OutputEntryPrint .titles.address_entry $address
  706. #    tkW3OutputEntryPrint .titles.title_entry $title
  707.     .preview.t.t configure -text "$title"
  708.  
  709. #puts stdout "uhhh: $address $title"
  710. }
  711.  
  712.  
  713. # Procedure: tkW3OutputSetMessage
  714. proc tkW3OutputSetMessage { message {duration ""}} {
  715. #    tkW3OutputEntryPrint .message $message
  716. #    if {$duration != ""} {
  717. #    after $duration {tkW3OutputSetMessage {}}
  718. #    }
  719. #    puts stdout "message: $message"
  720. }
  721.  
  722.  
  723. # Procedure: tkW3OutputSetScrollPosition
  724. proc tkW3OutputSetScrollPosition { value} {
  725.     .preview.vp.txt  yview $value
  726. }
  727.  
  728.  
  729. # Procedure: tkW3OutputToggleSet
  730. proc tkW3OutputToggleSet { w var} {
  731.     if {$var == 0} {
  732.         $w deselect
  733.     } {
  734.         $w select
  735.     }
  736. }
  737.  
  738.  
  739.  
  740.